home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / TOOL_USE / DISPEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-01  |  25KB  |  899 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * dispedit - display/edit support functions for interactive
  15.  *            configuration type programs. (3-1-89)
  16.  *
  17.  *)
  18.  
  19. {$i prodef.inc}
  20.  
  21. unit dispedit;
  22.  
  23. {$v-}
  24.  
  25. interface
  26.    uses dos, crt, tools;
  27.  
  28.    type
  29.       charset        = string[128];
  30.  
  31.       edit_functions = (display, edit, clear);
  32.  
  33.       border_styles  = (blank_border,          single_border,
  34.                         double_border,         mixed_border,
  35.                         taildouble_border,
  36.                         solid_border,          evensolid_border,
  37.                         thinsolid_border,      lohatch_border,
  38.                         medhatch_border,       hihatch_border);
  39.  
  40.       display_image_type = array[1..2000] of record
  41.          chr:  char;
  42.          attr: byte;
  43.       end;
  44.  
  45.       display_image_rec = record
  46.          crt:  display_image_type;
  47.          mode: word;
  48.          attr: byte;
  49.          wmin: word;
  50.          wmax: word;
  51.          x,y:  byte;
  52.       end;
  53.  
  54.    var
  55.       disp_mem:   ^display_image_type;
  56.  
  57.  
  58.    const
  59.       allchars:   charset = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~';
  60.       namechars:  charset = '!#$%&''()+-.0123456789:@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_{}~';
  61.  
  62.       YES         = 'Y';      NO          = 'N';
  63.       BACKSPACE   = #8;       TAB         = #9;
  64.       NEWLINE     = #13;      ESC         = #27;
  65.       F1          = #201;     F2          = #202;
  66.       F3          = #203;     F4          = #204;
  67.       F5          = #205;     F6          = #206;
  68.       F7          = #207;     F8          = #208;
  69.       F9          = #209;     F10         = #210;
  70.       HOME        = #213;     UP          = #214;
  71.       PGUP        = #215;     LEFT        = #217;
  72.       RIGHT       = #219;     ENDK        = #221;
  73.       DOWN        = #222;     PGDN        = #223;
  74.       INS         = #224;     DEL         = #225;
  75.       CTRL_F1     = #236;     CTRL_F2     = #237;
  76.       CTRL_F3     = #238;     CTRL_F9     = #244;
  77.       CTRL_F10    = #245;     CTRL_PGUP   = #18;
  78.       CTRL_PGDN   = #4;       CTRL_LEFT   = #1;
  79.       CTRL_RIGHT  = #2;       CTRL_HOME   = #5;
  80.       CTRL_END    = #3;       SHIFT_TAB   = #157;
  81.  
  82.       data_changed: boolean = false;
  83.  
  84.       py: integer = -1;
  85.       px: integer = -1;
  86.  
  87.       traceopen: boolean = false;
  88.  
  89.    var
  90.       tracefd: text;
  91.  
  92.  
  93.    procedure disp(s: string);
  94.    procedure displn(s: string);
  95.    procedure dispnl;
  96.  
  97.    function make_string(ch: char; size: byte): string;
  98.  
  99.    procedure display_border(topx,topy,
  100.                             botx,boty: integer;
  101.                             style:     border_styles);
  102.  
  103.    procedure beep;
  104.  
  105.    function get_key: char;
  106.  
  107.    procedure edit_string ( func:      edit_functions;
  108.                            x,y:       integer;
  109.                            prompt:    string;
  110.                            var data:  string;
  111.                            width:     integer;
  112.                            var term:  char );
  113.  
  114.    procedure edit_fname ( func:      edit_functions;
  115.                           x,y:       integer;
  116.                           prompt:    string;
  117.                           var data:  string;
  118.                           width:     integer;
  119.                           isdir:     boolean;
  120.                           var term:  char );
  121.  
  122.    procedure edit_chars  ( func:      edit_functions;
  123.                            x,y:       integer;
  124.                            prompt:    string;
  125.                            var data;
  126.                            width:     integer;
  127.                            var term:  char );
  128.  
  129.    procedure edit_integer( func:     edit_functions;
  130.                            x,y:      integer;
  131.                            prompt:   string;
  132.                            var data: integer;
  133.                            width:    integer;
  134.                            min,max:  integer;
  135.                            var term: char );
  136.  
  137.    procedure edit_word   ( func:     edit_functions;
  138.                            x,y:      integer;
  139.                            prompt:   string;
  140.                            var data: word;
  141.                            width:    integer;
  142.                            min,max:  word;
  143.                            var term: char );
  144.  
  145.    procedure edit_real   ( func:     edit_functions;
  146.                            x,y:      integer;
  147.                            prompt:   string;
  148.                            var data: real;
  149.                            width:    integer;
  150.                            deci:     integer;
  151.                            var term: char );
  152.  
  153.    procedure edit_yesno(   func:      edit_functions;
  154.                            x,y:       integer;
  155.                            prompt:    string;
  156.                            var data:  boolean;
  157.                            var term:  char );
  158.  
  159.    procedure edit_funkey( func:      edit_functions;
  160.                           x,y:       integer;
  161.                           prompt:    string;
  162.                           key:       char;
  163.                           var term:  char );
  164.  
  165.    procedure select_next_entry( func:    edit_functions;
  166.                                 var en:  integer;
  167.                                 maxen:   integer;
  168.                                 var key: char);
  169.  
  170.    procedure clear_screen;
  171.  
  172.    procedure vscroll_bar(current, min, max: word;
  173.                          x,y1,y2: byte);
  174.  
  175.    procedure hscroll_bar(current, min, max: word;
  176.                          y,x1,x2: byte);
  177.  
  178.    procedure opentrace(name: string);
  179.    procedure closetrace;
  180.  
  181.    procedure input(var line:  string;
  182.                    maxlen:    integer);
  183.  
  184.    procedure save_display(var disp: display_image_rec);
  185.    procedure restore_display(var disp: display_image_rec);
  186.    procedure shadow_display;
  187.  
  188.  
  189. implementation
  190.  
  191.  
  192.    (* -------------------------------------------------- *)
  193.    procedure disp(s: string);
  194.    begin
  195.       write(s);
  196.       if traceopen then
  197.          write(tracefd,s);
  198.    end;
  199.  
  200.    procedure dispnl;
  201.    begin
  202.       disp(^M^J);
  203.    end;
  204.  
  205.    procedure displn(s: string);
  206.    begin
  207.       disp(s);
  208.       dispnl;
  209.    end;
  210.  
  211.  
  212.    (* -------------------------------------------------- *)
  213.    function make_string(ch: char; size: byte): string;
  214.    var
  215.       st: string;
  216.    begin
  217.       fillchar(st[1],size,ch);
  218.       st[0] := chr(size);
  219.       make_string := st;
  220.    end;
  221.  
  222.  
  223.    (* -------------------------------------------------- *)
  224.    procedure display_border(topx,topy,
  225.                             botx,boty: integer;
  226.                             style:     border_styles);
  227.       (* display a window border.  enter with desired color settingx*)
  228.    var
  229.       left:        string[80];
  230.       right:       string[80];
  231.       top:         string[80];
  232.       bottom:      string[80];
  233.       width:       integer;
  234.       b:           string[8];
  235.       i,j:         integer;
  236.  
  237.    const
  238.      border_table:  array[blank_border..hihatch_border] of string[8] =
  239.        ('        ',  { blank     }         '┌─┐││└─┘',  { single    }
  240.         '╔═╗║║╚═╝',  { double    }         '╒═╕││╘═╛',  { mixed     }
  241.         '╠═╗║║╚═╝',  { taildouble}
  242.         '████████',  { solid     }         '█▀████▄█',  { evensolid }
  243.         '▐▀▌▐▌▐▄▌',  { thinsolid }         '░░░░░░░░',  { lohatch   }
  244.         '▒▒▒▒▒▒▒▒',  { medhatch  }         '▓▓▓▓▓▓▓▓'); { hihatch   }
  245.  
  246.       topleft  = 1;    {border character locations in border strings}
  247.       tophor   = 2;
  248.       topright = 3;
  249.       leftver  = 4;
  250.       rightver = 5;
  251.       botleft  = 6;
  252.       bothor   = 7;
  253.       botright = 8;
  254.  
  255.       filler = ^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J;
  256.  
  257.    begin
  258.       b := border_table[style];
  259.       width := botx - topx - 2;
  260.  
  261.    (* top and bottom of frame *)
  262.       bottom[0]    := chr(width+2);
  263.       top[0]       := chr(width+2);
  264.       top[1]       := b[topleft];
  265.       for i := 2 to width+1 do
  266.          top[i] := b[tophor];
  267.       top[width+2] := b[topright];
  268.  
  269.       bottom[0]       := chr(width+2);
  270.       bottom[1]       := b[botleft];
  271.       for i := 2 to width+1 do
  272.          bottom[i] := b[bothor];
  273.       bottom[width+2] := b[botright];
  274.  
  275.  
  276.    (* sides of frame *)
  277.       left := filler + filler;
  278.       right := left;
  279.       j := 1;
  280.       for i := 2 to boty - topy do
  281.       begin
  282.          left[j]:= b[leftver];
  283.          right[j]:= b[rightver];
  284.          j := j + 3;
  285.       end;
  286.       left[0]:= chr (j - 1);
  287.       right[0]:= left[0];
  288.  
  289.    (* draw the frame *)
  290.       gotoxy(topx,topy);     disp(top);
  291.       gotoxy(topx,topy+1);   disp(left);
  292.       gotoxy(botx-1,topy+1); disp(right);
  293.       gotoxy(topx,boty);     disp(bottom);
  294.    end;
  295.  
  296.  
  297.    (* -------------------------------------------------- *)
  298.    procedure beep;
  299.    begin
  300.       disp(^G);
  301.    end;
  302.  
  303.  
  304.    (* -------------------------------------------------- *)
  305.    function get_key: char;
  306.    var
  307.       c: char;
  308.    begin
  309.       c := readkey;
  310.       if c = #0 then
  311.          c := chr(ord(readkey) + 142);
  312.       get_key := c;
  313.    end;
  314.  
  315.  
  316.    (* -------------------------------------------------- *)
  317.    procedure raw_editor( func:       edit_functions;
  318.                          x,y:        integer;
  319.                          prompt:     string;
  320.                          var data:   string;
  321.                          width:      integer;
  322.                          var term:   char;
  323.                          upper:      boolean;
  324.                          legal:      charset );
  325.    var
  326.       col:        integer;
  327.       ch:         char;
  328.       filler:     string;
  329.       fillch:     char;
  330.     { firstkey:   boolean; }
  331.  
  332.    begin
  333.  
  334.       if length(data) > width then
  335.          data[0] := chr(width);
  336.       if upper then
  337.          stoupper(data);
  338.  
  339.       case func of
  340.          display:
  341.             fillch := '_';
  342.          edit:
  343.             fillch := '░';
  344.          clear:
  345.             begin
  346.                fillch := ' ';
  347.                data := '';
  348.             end;
  349.       end;
  350.  
  351.       filler := make_string( fillch, width - length(data) ) + ' ';
  352.  
  353.       lowvideo;
  354.       gotoxy( x, y );
  355.       disp( prompt );
  356.  
  357.       highvideo;
  358.       disp( copy( data, 1, width ) );
  359.  
  360.       if func <> edit then
  361.          lowvideo;
  362.       disp( filler );
  363.       highvideo;
  364.  
  365.    (* edit field contents only on edit calls *)
  366.       if ( func <> edit ) then
  367.          exit;
  368.  
  369.    (* general edit string function *)
  370.       inc(x,length(prompt));
  371.       col := 0;
  372.     { firstkey := true; }
  373.       term := '0';
  374.  
  375.       repeat
  376.          gotoxy( x + col, y );
  377.          ch := get_key;
  378.  
  379.          case ch of
  380.             HOME: col := 0;
  381.  
  382.             ENDK: col := length(data);
  383.  
  384.             LEFT: if col > 0 then
  385.                      dec(col)
  386.                   else
  387.                      term := UP;
  388.  
  389.             RIGHT:
  390.                   if col < length(data) then
  391.                      inc(col)
  392.                   else
  393.                      term := DOWN;
  394.  
  395.             DEL:  if col < length( data ) then
  396.                   begin
  397.                      delete( data, col + 1, 1 );
  398.                      disp( copy( data, col + 1, width )+ fillch );
  399.                      data_changed := true;
  400.                   end;
  401.  
  402.             INS:  if col < length( data ) then
  403.                   begin
  404.                      insert( ' ',data, col+1 );
  405.                      disp( copy( data, col+1, width ) );
  406.                      data_changed := true;
  407.                   end;
  408.  
  409.             BACKSPACE:
  410.                   if col > 0 then
  411.                   begin
  412.                      delete( data, col, 1 );
  413.                      disp( ^h + copy( data, col, width )+ fillch );
  414.                      dec(col);
  415.                      data_changed := true;
  416.                   end
  417.                   else
  418.                      beep;
  419.  
  420.             F1..F10, ESC,
  421.             NEWLINE, UP, DOWN,
  422.             PGUP, PGDN,
  423.             CTRL_HOME, CTRL_END:
  424.                   term := ch;
  425.  
  426.             else  begin
  427.                      if upper then
  428.                         ch := upcase(ch);
  429.  
  430.                      if pos(ch,legal) > 0 then
  431.                      begin
  432.  
  433.                       { if firstkey then
  434.                         begin
  435.                            data := '';
  436.                            disp( make_string( fillch, width ) );
  437.                            gotoxy( x + col, y );
  438.                         end; }
  439.  
  440.                         if col < width then
  441.                         begin
  442.                            inc(col);
  443.                            if col > length( data ) then
  444.                               data := data + ch
  445.                            else
  446.                               data[ col ] := ch;
  447.  
  448.                            disp( ch );
  449.                            data_changed := true;
  450.                         end
  451.                         else
  452.                            beep;
  453.                      end
  454.                      else
  455.  
  456.                      begin
  457.                         gotoxy(1,1);
  458.                         write('ch=',ord(ch):3);
  459.                         beep;
  460.                      end;
  461.                   end;
  462.          end;
  463.  
  464.        { firstkey := false; }
  465.  
  466.       until term <> '0';
  467.  
  468.       gotoxy( x, y );
  469.       highvideo;
  470.       disp( data );
  471.  
  472.       lowvideo;
  473.       disp( make_string( '_', width-length(data) ) );
  474.    end;
  475.  
  476.  
  477.    (* -------------------------------------------------- *)
  478.    procedure edit_string( func:      edit_functions;
  479.                           x,y:       integer;
  480.                           prompt:    string;
  481.                           var data:  string;
  482.                           width:     integer;
  483.                           var term:  char );
  484.    begin
  485.       raw_editor( func, x, y, prompt, data, width, term, false, allchars);
  486.    end;
  487.  
  488.  
  489.    (* -------------------------------------------------- *)
  490.    procedure edit_fname ( func:      edit_functions;
  491.                           x,y:       integer;
  492.                           prompt:    string;
  493.                           var data:  string;
  494.                           width:     integer;
  495.                           isdir:     boolean;
  496.                           var term:  char );
  497.    begin
  498.       raw_editor( func, x, y, prompt, data, width, term, true, namechars);
  499.  
  500.       if isdir and (data[length(data)] <> '\') then
  501.       begin
  502.          inc(data[0]);
  503.          data[length(data)] := '\';
  504.       end;
  505.    end;
  506.  
  507.  
  508.    (* -------------------------------------------------- *)
  509.    procedure edit_chars( func:      edit_functions;
  510.                          x,y:       integer;
  511.                          prompt:    string;
  512.                          var data;
  513.                          width:     integer;
  514.                          var term:  char );
  515.    var
  516.       cdata:   array[1..255] of char absolute data;
  517.       sdata:   string;
  518.       i:       integer;
  519.  
  520.    begin
  521.       for i := 1 to width do
  522.          sdata[i] := cdata[i];
  523.       sdata[0] := chr(width);
  524.       while sdata[length(sdata)] = ' ' do
  525.          dec(sdata[0]);
  526.  
  527.       raw_editor( func, x, y, prompt, sdata, width, term, false, allchars);
  528.  
  529.       sdata := ljust(sdata,width);
  530.       for i := 1 to width do
  531.          cdata[i] := sdata[i];
  532.    end;
  533.  
  534.  
  535.    (* -------------------------------------------------- *)
  536.    procedure edit_integer( func:     edit_functions;
  537.                            x,y:      integer;
  538.                            prompt:   string;
  539.                            var data: integer;
  540.                            width:    integer;
  541.                            min,max:  integer;
  542.                            var term: char );
  543.    var
  544.       temp:       string;
  545.       code:       integer;
  546.       new_data:   integer;
  547.  
  548.    begin
  549.       str(data,temp);      { convert data from float to string }
  550.  
  551.       repeat
  552.          raw_editor( func, x, y, prompt, temp, width, term, false, '0123456789-');
  553.  
  554.          if func=edit then
  555.             val( temp, new_data, code )
  556.          else
  557.             code := 0;              { convert string to int only when editing }
  558.  
  559.          if (func = edit) and (( new_data < min ) or ( new_data > max )) then
  560.             code := 1;              { invalidate data data if out of range }
  561.  
  562.          if code <> 0 then
  563.          begin
  564.             beep;           { code is 0 if data is valid }
  565.             str(data,temp);
  566.             if (term >= F1) and (term <= F10) then
  567.                exit;                { allow invalid data without change on F-keys}
  568.          end;
  569.  
  570.       until ( code = 0 );
  571.  
  572.       if func=edit then
  573.          data := new_data;
  574.    end;
  575.  
  576.  
  577.    (* -------------------------------------------------- *)
  578.    procedure edit_word( func:     edit_functions;
  579.                         x,y:      integer;
  580.                         prompt:   string;
  581.                         var data: word;
  582.                         width:    integer;
  583.                         min,max:  word;
  584.                         var term: char );
  585.    var
  586.       temp:       string;
  587.       code:       integer;
  588.       new_data:   word;
  589.  
  590.    begin
  591.       str(data,temp);      { convert data from float to string }
  592.  
  593.       repeat
  594.          raw_editor( func, x, y, prompt, temp, width, term, false, '0123456789');
  595.  
  596.          if func=edit then
  597.             val( temp, new_data, code )
  598.          else
  599.             code := 0;              { convert string to int only when editing }
  600.  
  601.          if (func = edit) and (( new_data < min ) or ( new_data > max )) then
  602.             code := 1;              { invalidate data data if out of range }
  603.  
  604.          if code <> 0 then
  605.          begin
  606.             beep;           { code is 0 if data is valid }
  607.             str(data,temp);
  608.             if (term >= F1) and (term <= F10) then
  609.                exit;                { allow invalid data without change on F-keys}
  610.          end;
  611.  
  612.       until ( code = 0 );
  613.  
  614.       if func=edit then
  615.          data := new_data;
  616.    end;
  617.  
  618.  
  619.    (* -------------------------------------------------- *)
  620.    procedure edit_real   ( func:     edit_functions;
  621.                            x,y:      integer;
  622.                            prompt:   string;
  623.                            var data: real;
  624.                            width:    integer;
  625.                            deci:     integer;
  626.                            var term: char );
  627.    var
  628.       temp:       string;
  629.       code:       integer;
  630.       new_data:   real;
  631.  
  632.    begin
  633.       str(data:0:deci,temp);      { convert data from float to string }
  634.  
  635.       repeat
  636.          raw_editor( func, x, y, prompt, temp, width, term, true, '0123456789.E-');
  637.  
  638.          if func=edit then
  639.             val( temp, new_data, code )
  640.          else
  641.             code := 0;              { convert string to int only when editing }
  642.  
  643.          if code <> 0 then
  644.          begin
  645.             beep;           { code is 0 if data is valid }
  646.             str(data,temp);
  647.             if (term >= F1) and (term <= F10) then
  648.                exit;                { allow invalid data without change on F-keys}
  649.          end;
  650.  
  651.       until ( code = 0 );
  652.  
  653.       if func=edit then
  654.          data := new_data;
  655.    end;
  656.  
  657.  
  658.    (* -------------------------------------------------- *)
  659.    procedure edit_yesno( func:      edit_functions;
  660.                          x,y:       integer;
  661.                          prompt:    string;
  662.                          var data:  boolean;
  663.                          var term:  char );
  664.    var
  665.       yesno:   string;
  666.  
  667.    begin
  668.       if data then
  669.          yesno := 'Y'
  670.       else
  671.          yesno := 'N';
  672.       raw_editor( func, x, y, prompt, yesno, 1, term, true, 'YN');
  673.       data := yesno[1] = 'Y';
  674.    end;
  675.  
  676.  
  677.    (* -------------------------------------------------- *)
  678.    procedure edit_funkey( func:      edit_functions;
  679.                           x,y:       integer;
  680.                           prompt:    string;
  681.                           key:       char;
  682.                           var term:  char );
  683.    begin
  684.       if func = edit then
  685.       begin
  686.          gotoxy( x, y );
  687.          textbackground(white);
  688.          textcolor(black);
  689.          disp( prompt );
  690.  
  691.          term := get_key;
  692.          if term = NEWLINE then
  693.             term := key;
  694.       end;
  695.  
  696.       gotoxy( x, y );
  697.       textbackground(black);
  698.       textcolor(white);
  699.       disp( prompt );
  700.    end;
  701.  
  702.  
  703.    (* -------------------------------------------------- *)
  704.    procedure select_next_entry( func:    edit_functions;
  705.                                 var en:  integer;
  706.                                 maxen:   integer;
  707.                                 var key: char);
  708.    begin
  709.       if func = display then
  710.          exit;
  711.  
  712.       case key of
  713.          TAB, NEWLINE, DOWN:
  714.             begin
  715.                key := DOWN;
  716.                if en < maxen then
  717.                   inc(en)
  718.                else
  719.                   en := 1;
  720.             end;
  721.  
  722.          UP:   if en > 1 then
  723.                   dec(en)
  724.                else
  725.                   en := maxen;
  726.  
  727.          CTRL_HOME:
  728.                begin
  729.                   en := 1;
  730.                   key := DOWN;
  731.                end;
  732.  
  733.          CTRL_END:
  734.                begin
  735.                   en := maxen;
  736.                   key := UP;
  737.                end;
  738.       end;
  739.    end;
  740.  
  741. (* -------------------------------------------------- *)
  742.    procedure clear_screen;
  743.    begin
  744.       clrscr;
  745.       py := -1;
  746.       px := -1;
  747.    end;
  748.  
  749. (* -------------------------------------------------- *)
  750.    procedure vscroll_bar(current, min, max: word;
  751.                          x,y1,y2: byte);
  752.    var
  753.       y: integer;
  754.       i: integer;
  755.    begin
  756.       y := ((current-min) * (y2-y1)) div (max-min) + y1;
  757.       if y = py then
  758.          exit;
  759.  
  760.       py := y;
  761.       for i := y1 to y2 do
  762.       begin
  763.          gotoxy(x,i);
  764.          if i = y then
  765.             disp('█')
  766.          else
  767.             disp('░');
  768.       end;
  769.    end;
  770.  
  771. (* -------------------------------------------------- *)
  772.    procedure hscroll_bar(current, min, max: word;
  773.                          y,x1,x2: byte);
  774.    var
  775.       x: integer;
  776.       i: integer;
  777.    begin
  778.       x := ((current-min) * (x2-x1)) div (max-min) + x1;
  779.       if x = px then
  780.          exit;
  781.  
  782.       px := x;
  783.       for i := x1 to x2 do
  784.       begin
  785.          gotoxy(i,y);
  786.          if i = x then
  787.             disp('█')
  788.          else
  789.             disp('░');
  790.       end;
  791.    end;
  792.  
  793.    (* ------------------------------------------------------------ *)
  794.    procedure input(var line:  string;
  795.                    maxlen:    integer);
  796.    var
  797.       c:     char;
  798.  
  799.    begin
  800.       line := '';
  801.  
  802.       repeat
  803.          c := get_key;
  804.  
  805.          case c of
  806.             ' '..#126:
  807.                if length(line) < maxlen then
  808.                begin
  809.                   inc(line[0]);
  810.                   line[length(line)] := c;
  811.                   disp(c);
  812.                end
  813.                else
  814.                   beep;
  815.  
  816.             ^H,#127:
  817.                if length(line) > 0 then
  818.                begin
  819.                   dec(line[0]);
  820.                   disp(^H' '^H);
  821.                end;
  822.  
  823.             ^M:   ;
  824.  
  825.             ^C:   begin
  826.                       displn('^C');
  827.                       halt(99);
  828.                   end;
  829.          end;
  830.  
  831.       until (c = ^M);
  832.    end;
  833.  
  834.  
  835. (* -------------------------------------------------- *)
  836.    procedure opentrace(name: string);
  837.    begin
  838.       assign(tracefd,name);
  839.       rewrite(tracefd);
  840.       traceopen := true;
  841.    end;
  842.  
  843.    procedure closetrace;
  844.    begin
  845.       close(tracefd);
  846.       traceopen := false;
  847.    end;
  848.  
  849.  
  850.  
  851. (* -------------------------------------------------- *)
  852.    procedure save_display(var disp: display_image_rec);
  853.    begin
  854.       disp.crt := disp_mem^;
  855.       disp.mode := lastmode;
  856.       disp.attr := textattr;
  857.       disp.wmin := windmin;
  858.       disp.wmax := windmax;
  859.       disp.x := wherex;
  860.       disp.y := wherey;
  861.    end;
  862.  
  863.    procedure restore_display(var disp: display_image_rec);
  864.    begin
  865.       disp_mem^ := disp.crt;
  866.       lastmode := disp.mode;
  867.       textattr := disp.attr;
  868.       windmin := disp.wmin;
  869.       windmax := disp.wmax;
  870.       gotoxy(disp.x,disp.y);
  871.    end;
  872.  
  873.  
  874.    procedure shadow_display;
  875.    var
  876.       i: integer;
  877.    begin
  878.       for i := 1 to 2000 do
  879.          with disp_mem^[i] do
  880.             attr := attr and 7;
  881.    end;
  882.  
  883.  
  884. (* -------------------------------------------------- *)
  885. var
  886.    Vmode: byte absolute $0040:$0049;   {Current video mode}
  887. begin
  888.    if (Vmode = 1{MDA}) or (Vmode = 7{VgaMono}) then
  889.       disp_mem := ptr($B000,0)
  890.    else
  891.       disp_mem := ptr($B800,0);
  892.  
  893.    assignCrt(output);
  894.    rewrite(output);
  895.    directvideo := pos('/BIO',GetEnv('PCB')) = 0;
  896. end.
  897.  
  898.  
  899.